;; representation of a white stone
(defvar *white* '(w))

;; representation of a black stone
(defvar *black* '(b))

;; sizeofboard
(defvar *boardsize* 19)


;;;
;;;
;;; Utilities
;;;
;;;


;; for loop
;;(defmacro for (var start stop &body body)
;;  (let ((gstop (gensym)))
;;    '(do ((,var ,start (1+ var))
;;	  (,gstop ,stop))
;;         ((> ,var ,gstop))
;;	,@body)))

;; takes  list, and reduces it to a set (i.e. removes doubles)
(defun set-reduce (reduceList)
    (if (cdr reduceList)
	(if (find (car reduceList) 
		  (cdr reduceList) 
		  :test 'equal)
	    (set-reduce (cdr reduceList))
	    (cons (car reduceList)
		  (set-reduce (cdr reduceList))))
	reduceList))




;;;
;;; Program Code
;;;


;;; defines a board.  A board is made up of 3 lists:
;;; a list of the empty points on the board, the black
;;; points on the board, and the white points.  Each 
;;; element of the list should be a complex number of
;;; the form x + yi.
;;;
;;; When initially instantiated, in empty state.
(defclass board (STANDARD-OBJECT)
  ((empty :initarg :empty :accessor empty :initform (gen-original-empty-list))
   (black :initarg :black :accessor black :initform '())
   (white :initarg :white :accessor white :initform '())
   ;; used in determining ko - last moves
   ;; initialized with an invalid move
   (last-black :initarg :last-black :accessor last-black :initform #C(-1 -1))
   (last-white :initarg :last-white :accessor last-white :initform #C(-1 -1))
   (num-last-capture :initarg :capture :accessor num-last-capture :initform 0)))

;; makes copy of board for nondestrutive manipulation
(defmethod copy ((b board))
  (copy-board (make-instance board :empty (empty b)
				   :black (black b)
				   :white (white b)
				   :last-black (last-black b)
				   :last-white (last-white b)
				   :capture (num-last-capture b))))


(defun gen-original-empty-list ()
  (let ((lst '()))
    (dotimes (x *boardsize*)
      (dotimes (y *boardsize*)
	(push (complex (+ x 1) (+ y 1)) lst)))
    lst))


;; plays a move for either black or white
;; assumes that the point is free and the move is valid (e.g. no ko, not suicide)
;; check move's validity before calling this method
(defmethod play-move ((b board) point player)
  (if (eql player *black*)
    (play-move-helper b point #'black #'white #'last-black)
    (play-move-helper b point #'white #'black #'last-white)))
(defmethod play-move-helper ((b board) point accessor other-accessor last-accessor)
  )




;;;
;;; PREDICATES
;;;

;;; is this move valid?
;;; i.e. not ko, not in suicide
(defmethod valid-movep ((b board) point player)
  (and (find point (empty b)) 
       (kop b point player)
       (suicidep b point player)))

;; is a given move suicide?
(defmethod suicidep ((b board) point player)
  (if (eql player *black*)
    (suicidep-helper b point #'black #'white)
    (suicidep-helper b point #'white #'black)))

(defmethod suicidep-helper ((b board) point accessor other-accessor)
  (let ((temp-board (copy b))
	(enemy-neighbors (intersection (get-neighbors point) 
				       (funcall other-accessor b))))
    ;; play point non-destructively -- in a temporary board
    (setf (funcall accessor temp-board) 
	  (cons point (funcall accessor temp-board)))
    (setf (empty temp-board) (remove point (empty temp-board)))
    		;; if you've captured something, you must have at least one
		;; liberty, and aren't in suicide
    (cond ((remove-if #'null 
		      (mapcan (lambda (point-prime) 
				(capturedp temp-board point-prime))
			      enemy-neighbors))
	   t)
	  ;; Didn't capture anything; Have no liberties
	  ((capturedp temp-board point) nil)
	  ;; Have liberties, not suicide
	  (t t))))

;; is a group of stones captured?  t if they have no liberties
;; start with a point and search for all the liberties its group has
(defmethod capturedp ((b board) point)
  (caputuredp-helper b point '() ))

;; is a group of stones captured?  t if they have no liberties
;; 	helper function; recursion keeps track of where it has been in the recursion
(defmethod caputuredp-helper ((b board) point has-been)
  (push point has-been)
  (let* ((next-points (set-difference (get-neighbors point) has-been))
	 (black-points (intersection next-points (black b)))
	 (empty-points (intersection next-points (empty b))))
    (cond
      (empty-points nil)
      (black-points
	(remove-if #'null
		   (mapcan (lambda (point-prime) 
			     (capturedp-helper b point-prime has-been))
			   black-points))
      (t t))))


;; is there currently a ko?
;; player should be the variable *black* or *white*
(defmethod kop ((b board) point player)
  (if (eql player *black*)
    (kop-helper board point (last-black board))
    (kop-helper board point (last-white board))))

;; helper function for kop
(defmethod kop-helper ((b board) point last-point)
  (and (= 1 (num-last-capture board))
       (= last-point point)))








;;;
;;; Display
;;;



;; takes a board object and creates a displayable board with the position on it
;; The displayable board is an n-by-n tree with B, W or NIL representing the board
(defmethod display-board ((b board))
  (gen-position (gen-display-board) (black b) (white b)))


;; generate a position of a list of black stones and white
(defun gen-position (board black white)
    (cond
	(black (set-point (gen-position board (cdr black) white) (car black) *black*))
	(white (set-point (gen-position board  black (cdr white)) (car white) *white*))
	(t	board)))

;; make board of size x-by-x - defined by boardsize
(defun gen-display-board () 
    (make-list *boardsize* :initial-element
	    (make-list *boardsize* :initial-element nil)))

;; find the value of the (x,y) point on board
(defun get-point-color (board point)
    (nth (- (imagpart point) 1)
	(nth (- (realpart point) 1) board)))

;; copy a row of the board
(defun copy-row (row)
    (if row 
	(cons (car row) 
	      (copy-row (cdr row)))
	nil))

;; copy a row of the board, changing one value
(defun change-row (row y value)
    (if row
	(if (= y 1)
	    (cons value 
		(change-row (cdr row) (- y 1) value))
	    (cons (car row) 
		(change-row (cdr row) (- y 1) value)))
	nil))

;; recursively copy board, changing one value 
(defun set-point (board point value)  
    (if board
	(if (= (realpart point) 1)
	     (cons (change-row (car board) (imagpart point) value) 
		(set-point (cdr board) (- point 1) value))
	    (cons (copy-row (car board)) 
		(set-point (cdr board) (- point 1) value)))
	nil))


;; return any valid ajacent points to a stone in a list of #C(x y) points
(defun get-neighbors (point)
    (let ( (neighbors (cons '() '()))
	   (x (realpart point))
	   (y (imagpart point)))
	(if (> x 0) 
	    (push (complex (- x 1) y) (car neighbors)))
	(if (> y 0)
	    (push (complex x (- y 1)) (car neighbors)))
	(if (< x *boardlength*)
	    (push (complex (+ x 1) y) (car neighbors)))
	(if (< y *boardlength*)
	    (push (complex x (+ y 1)) (car neighbors)))))


